home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / utilmus / metronom.lha / Metronome / Metronome.e < prev    next >
Text File  |  1996-05-18  |  8KB  |  307 lines
  1. -> Metronome E source file
  2. -> View with EE to get folded procedures.
  3. -> This source is not well commented and some names are in
  4. -> Dutch, sorry for that.
  5.  
  6. OPT OSVERSION=37
  7.  
  8. MODULE 'intuition/intuition','intuition/screens','gadtools',
  9.        'libraries/gadtools','exec/ports','exec/io','devices/timer',
  10.        'graphics/text','exec/tasks','tools/easygui','dos/dos',
  11.        'amigalib/io','devices/audio','exec/memory','exec/nodes',
  12.        'graphics/gfxbase','*metronome_locale','locale','libraries/locale'
  13.  
  14. CONST RATE_MIN=40,RATE_MAX=216,RATE_DEFAULT=80
  15. CONST RATE_MAX1=RATE_MAX+1
  16.  
  17. -> There is no E support in CatComp :-(
  18. ENUM STR_ERR_LIB,STR_ERR_CRMP,STR_ERR_CRIO,STR_ERR_DEV,STR_ERR_ARGS,
  19.      STR_ERR_FILE,STR_ERR_MEM,STR_WINDOW_TITLE=100,STR_MM_GAD,STR_TEMPO_GAD,
  20.      STR_DELAY_GAD,STR_QUIT_GAD,STR_DEF_TEMPO_FILE=200
  21.  
  22. ENUM ERR_NONE,ERR_LIB,ERR_CRMP,ERR_CRIO,ERR_DEV,ERR_ARGS,ERR_FILE
  23.  
  24. RAISE ERR_LIB  IF OpenLibrary()=NIL,
  25.       ERR_CRMP IF CreateMsgPort()=NIL,
  26.       ERR_CRIO IF CreateIORequest()=NIL,
  27.       ERR_FILE IF FileLength()<=0
  28.  
  29. DEF openerr=-1,timerMP=NIL:PTR TO mp,timerIO=NIL:PTR TO timerequest,
  30.     complete=TRUE
  31. DEF aOpenErr=-1,audMP=NIL:PTR TO mp,audIO=NIL:PTR TO ioaudio,aUnit
  32. DEF sFile[256]:STRING,sRate=10000,sPeriod,sLen,sBuffer=NIL,sRight
  33.  
  34. DEF rate=80,dSecs,dMicro
  35. DEF tStr[80]:STRING,dtStr[80]:STRING
  36.  
  37. DEF tempofile[256]:STRING,tname[RATE_MAX1]:ARRAY OF LONG
  38.  
  39. DEF catalog=NIL,locale=NIL:PTR TO locale,rate_str[40]:STRING
  40.  
  41. DEF gh=NIL:PTR TO guihandle
  42. DEF prop=NIL,text=NIL,dtext=NIL,button=NIL
  43.  
  44. PROC main() HANDLE
  45.   DEF rda,a[5]:ARRAY OF LONG,in
  46.   gadtoolsbase:=OpenLibrary('gadtools.library',0)
  47.   -> For GT_SetGadgetAttrsA(); EasyGUI doesn't give GadToolsBase.
  48.   openlocale()
  49.   timerMP:=CreateMsgPort()
  50.   timerIO:=CreateIORequest(timerMP,SIZEOF timerequest)
  51.   openerr:=OpenDevice('timer.device',UNIT_VBLANK,timerIO,0)
  52.   IF openerr THEN Raise(ERR_DEV)
  53.   a[0]:=[RATE_DEFAULT]
  54.   a[1]:='PROGDIR:Metronome.SND'
  55.   a[2]:=[10000]
  56.   a[3]:=FALSE
  57.   a[4]:=string(STR_DEF_TEMPO_FILE)
  58.   IF rda:=ReadArgs('R=RATE/N,SF=SOUNDFILE,SR=SOUNDRATE/N,RIGHT/S,TF=TEMPOFILE',a,NIL)
  59.     rate:=Bounds(Long(a[0]),RATE_MIN,RATE_MAX)
  60.     StrCopy(sFile,a[1])
  61.     sRate:=Long(a[2])
  62.     sPeriod:=audioPeriod(sRate)
  63.     sRight:=a[3]
  64.     StrCopy(tempofile,a[4])
  65.     FreeArgs(rda)
  66.   ELSE
  67.     Raise(ERR_ARGS)
  68.   ENDIF
  69.   readtempofile()
  70.   sLen:=FileLength(sFile)
  71.   sBuffer:=NewM(sLen,MEMF_CHIP OR MEMF_PUBLIC)
  72.   IF in:=Open(sFile,MODE_OLDFILE)
  73.     Read(in,sBuffer,sLen)
  74.     Close(in)
  75.   ELSE
  76.     Raise(ERR_FILE)
  77.   ENDIF
  78.   audioInit()
  79.   calcdelay()
  80.   openwindow()
  81.   processMsg()
  82. EXCEPT DO
  83.   closewindow()
  84.   audioUnInit()
  85.   IF sBuffer THEN Dispose(sBuffer)
  86.   IF openerr=0
  87.     IF complete=FALSE
  88.       AbortIO(timerIO)
  89.       WaitIO(timerIO)
  90.     ENDIF
  91.     CloseDevice(timerIO)
  92.   ENDIF
  93.   IF timerIO THEN DeleteIORequest(timerIO)
  94.   IF timerMP THEN DeleteMsgPort(timerMP)
  95.   closelocale()
  96.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  97.   SELECT exception
  98.     CASE ERR_LIB;  WriteF(string(STR_ERR_LIB))
  99.     CASE ERR_CRMP; WriteF(string(STR_ERR_CRMP))
  100.     CASE ERR_CRIO; WriteF(string(STR_ERR_CRIO))
  101.     CASE ERR_DEV;  WriteF(string(STR_ERR_DEV))
  102.     CASE ERR_ARGS; PrintFault(IoErr(),string(STR_ERR_ARGS))
  103.     CASE ERR_FILE; WriteF(string(STR_ERR_FILE),sFile)
  104.     CASE "MEM";    WriteF(string(STR_ERR_MEM))
  105. ->    CASE ERR_SCR;  WriteF('Error: LockPubScreen() failed.\n')
  106. ->    CASE ERR_WND;  WriteF('Error: couldn''t open window.\n')
  107. ->    CASE ERR_VISU; WriteF('Error: GetVisualInfoA() didn't.\n')
  108. ->    CASE ERR_CGAD; WriteF('Error: couldn''t create gadget.\n')
  109.   ENDSELECT
  110. ENDPROC IF exception THEN 10 ELSE 0
  111.  
  112. -> The program should run without locale.library and there is an automatic
  113. -> exception on OpenLibrary().
  114. PROC openlocale() HANDLE
  115.   localebase:=OpenLibrary('locale.library',0)
  116.   IF localebase
  117.     locale:=OpenLocale(NIL)
  118.     catalog:=OpenCatalogA(locale,'metronome.catalog',[0])
  119.   ENDIF
  120. EXCEPT -> Dummy exception handler
  121. ENDPROC
  122.  
  123. PROC closelocale()
  124.   IF localebase
  125.     IF catalog THEN CloseCatalog(catalog)
  126.     IF locale THEN CloseLocale(locale)
  127.     CloseLibrary(localebase)
  128.   ENDIF
  129. ENDPROC
  130.  
  131. -> Timer
  132. PROC sendreq()
  133.   timerIO.io.command:=TR_ADDREQUEST
  134.   timerIO.time.secs:=dSecs
  135.   timerIO.time.micro:=dMicro
  136.   SendIO(timerIO)
  137.   complete:=FALSE
  138. ENDPROC
  139.  
  140. PROC calcdelay()
  141.   DEF m
  142.   m:=Div(60000000,rate)
  143.   dSecs:=Div(m,1000000)
  144.   dMicro:=m-Mul(dSecs,1000000)
  145. ->  WriteF('RATE=\d, SECS=\d, MICRO=\d\n',rate,dSecs,dMicro)
  146. ENDPROC
  147.  
  148. PROC openwindow()
  149.   StrCopy(rate_str,string(STR_MM_GAD))
  150.   StrAdd(rate_str,'    ')
  151.   gh:=guiinit(string(STR_WINDOW_TITLE),
  152.     [ROWS,
  153.       prop:=[SLIDE,{aSlider},rate_str,FALSE,RATE_MIN,RATE_MAX,rate,10,'\d[3]'],
  154.       text:=[TEXT,tStr,string(STR_TEMPO_GAD),TRUE,30],
  155.       dtext:=[TEXT,dtStr,string(STR_DELAY_GAD),TRUE,8],
  156.       button:=[SBUTTON,1,string(STR_QUIT_GAD)]
  157.     ])
  158.   setTempoText()
  159.   setslide(gh,prop,rate)
  160. ENDPROC
  161.  
  162. PROC closewindow()
  163.   IF gh THEN cleangui(gh)
  164.   gh:=NIL
  165. ENDPROC
  166.  
  167. PROC aSlider(nop,new)
  168.   rate:=new
  169.   calcdelay()
  170.   setTempoText()
  171. ENDPROC
  172.  
  173. PROC setTempoText()
  174.   DEF t:PTR TO CHAR,tgad,dtgad
  175.   IF tname[RATE_MIN]
  176.     t:=tname[rate]
  177.   ELSE
  178.     SELECT RATE_MAX1 OF rate
  179. ->      CASE RATE_MIN TO 40; t:='Zeer langzaam'
  180. ->      CASE 41 TO 50; t:='Langzaam'
  181. ->      CASE 51 TO 70; t:='Ongeveer 1x per seconde'
  182. ->      CASE 71 TO 90; t:='Normaal tempo'
  183. ->      CASE 91 TO 140; t:='Snel'
  184. ->      CASE 141 TO RATE_MAX; t:='Zeer snel'
  185.       CASE 40 TO 60; t:='Slow'
  186.       CASE 61 TO 90; t:='Moderately slow'
  187.       CASE 91 TO 120; t:='Moderate'
  188.       CASE 121 TO 160; t:='Moderately fast'
  189.       CASE 161 TO RATE_MAX; t:='Fast'
  190.   ENDSELECT
  191.   ENDIF
  192.   StrCopy(tStr,t)
  193.   tgad:=findgadget(gh,text)
  194.   Gt_SetGadgetAttrsA(tgad,gh.wnd,NIL,[GTTX_TEXT,tStr,0])
  195.   StringF(dtStr,'\d\s\z\d[6]s',dSecs,decimalpoint(),dMicro)
  196.   dtgad:=findgadget(gh,dtext)
  197.   Gt_SetGadgetAttrsA(dtgad,gh.wnd,NIL,[GTTX_TEXT,dtStr,0])
  198. ENDPROC
  199.  
  200. PROC readtempofile() HANDLE
  201.   DEF in,l[80]:STRING,num,read,s:PTR TO CHAR,i
  202.   FOR i:=RATE_MIN TO RATE_MAX DO tname[i]:=NIL
  203.   in:=Open(tempofile,MODE_OLDFILE)
  204.   WHILE Fgets(in,l,80)
  205.     num,read:=Val(l)
  206.     IF num>=RATE_MIN AND (num<=RATE_MAX) THEN tname[num]:=dupstr_rtf(TrimStr(l+read))
  207.   ENDWHILE
  208.   FOR i:=RATE_MIN+1 TO RATE_MAX
  209.     IF tname[i]=NIL THEN tname[i]:=tname[i-1]
  210.   ENDFOR
  211. EXCEPT DO
  212.   Close(in)
  213. ENDPROC
  214.  
  215. PROC dupstr_rtf(str)
  216.   DEF new:PTR TO CHAR
  217.   new:=NewR(StrLen(str)+1)
  218.   AstrCopy(new,str,StrLen(str))
  219. ENDPROC new
  220.  
  221. PROC processMsg()
  222.   DEF sigs,going=TRUE,rcvd
  223.   sigs:=gh.sig OR Shl(1,timerMP.sigbit) OR SIGBREAKF_CTRL_C
  224.   sendreq()
  225.   WHILE going
  226.     rcvd:=Wait(sigs)
  227.     IF GetMsg(timerMP)
  228.       sendreq()
  229.       tik()
  230.     ENDIF
  231.     IF guimessage(gh)>=0 THEN going:=FALSE
  232.     IF rcvd AND SIGBREAKF_CTRL_C THEN going:=FALSE
  233.   ENDWHILE
  234. ENDPROC
  235.  
  236. PROC tik()
  237. ->  WriteF('*')
  238.   audioSound(sBuffer,sLen,sPeriod)
  239. ENDPROC
  240.  
  241. PROC audioInit()
  242.   audMP:=CreateMsgPort()
  243.   audIO:=CreateIORequest(audMP,SIZEOF ioaudio)
  244.   audIO::ln.pri:=0
  245.   audIO.allockey:=0
  246.   IF sRight
  247.     audIO.data:=[%0100,%0010,%1000,%0001]:CHAR
  248.   ELSE
  249.     audIO.data:=[%1000,%0001,%0100,%0010]:CHAR
  250.   ENDIF
  251.   audIO.length:=4
  252.   aOpenErr:=OpenDevice('audio.device',0,audIO,0)
  253.   IF aOpenErr THEN Raise(ERR_DEV)
  254.   aUnit:=audIO.io.unit
  255. ENDPROC
  256.  
  257. PROC audioPeriod(rate)
  258.   DEF gfx:PTR TO gfxbase
  259.   gfx:=gfxbase
  260.   IF gfx.displayflags AND PAL
  261.     sPeriod:=Div(3546895,rate)
  262.   ELSE
  263.     sPeriod:=Div(3579547,rate)
  264.   ENDIF
  265. ENDPROC sPeriod
  266.  
  267. PROC audioSound(data,len,period)
  268.   audIO.io.unit:=aUnit
  269.   audIO.io.command:=CMD_WRITE
  270.   audIO.io.flags:=ADIOF_PERVOL
  271.   audIO.data:=data
  272.   audIO.length:=len AND $FFFFFFFE
  273.   audIO.period:=period
  274.   audIO.volume:=64
  275.   audIO.cycles:=1
  276.   beginIO(audIO)
  277.   WaitIO(audIO)
  278.   GetMsg(audMP)
  279. ENDPROC
  280.  
  281. PROC audioUnInit()
  282.   IF aOpenErr=0
  283.     audIO.io.command:=ADCMD_FREE
  284.     audIO.io.unit:=aUnit
  285.     DoIO(audIO)
  286.     CloseDevice(audIO)
  287.   ENDIF
  288.   IF audIO THEN DeleteIORequest(audIO)
  289.   IF audMP THEN DeleteMsgPort(audMP)
  290. ENDPROC
  291.  
  292. PROC string(num)
  293.   DEF li[2]:ARRAY OF LONG
  294.   li[0]:=localebase
  295.   li[1]:=catalog
  296.   MOVE.L li,A0
  297.   MOVE.L num,D0
  298. ENDPROC getString()
  299.  
  300. PROC decimalpoint() IS IF locale THEN locale.decimalpoint ELSE '.'
  301.  
  302. PROC vers() IS '$VER: Metronome 1.0 (18-May-1996) by Jilles Tjoelker'
  303. /*EE folds
  304. -1
  305. 44 65 49 6 52 5 56 5 59 5 62 11 65 2 68 3 71 24 74 12 77 3 80 12 83 2 86 13 89 7 92 11 95 8 98 5 
  306. EE folds*/
  307.